home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol117 / display.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  21.3 KB  |  782 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Display Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.0"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 150  DIM PA.ID(1000), CH.ID(1000), PERS.NO(400), M.NO(400)
  14. 160  DIM PERS(15), CH(55)
  15. 170  REM Produce the first screen
  16. 175  KEY OFF : CLS
  17. 180  REM Draw the outer double box
  18. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  19. 190  REM Find the title location
  20. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  21. 200  REM Draw the title box
  22. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  23. 210  REM Print the title
  24. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  25. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  26. 225  REM Draw the Contribution box
  27. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  28. 235  REM Request the Contribution
  29. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  30. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  31. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  32. 255  REM Draw the Mailing Label
  33. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  34. 265  REM Print the Name and Address
  35. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  36. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  37. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  38. 285  REM Draw the Copyright box
  39. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  40. 295  REM Print the Copyright
  41. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  42. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  43. 310  GOTO 740
  44. 400  REM subroutine to print a double box
  45. 405  COLOR 5
  46. 410  FOR I = R1 + 1 TO R2 - 1
  47. 420   LOCATE I, C1 : PRINT CHR$(186);
  48. 430   LOCATE I, C2 : PRINT CHR$(186);
  49. 440  NEXT I
  50. 450  FOR J = C1 + 1 TO C2 - 1
  51. 460   LOCATE R1, J : PRINT CHR$(205);
  52. 470   LOCATE R2, J : PRINT CHR$(205);
  53. 480  NEXT J
  54. 490   LOCATE R1, C1 : PRINT CHR$(201);
  55. 500   LOCATE R1, C2 : PRINT CHR$(187);
  56. 510   LOCATE R2, C1 : PRINT CHR$(200);
  57. 520   LOCATE R2, C2 : PRINT CHR$(188);
  58. 525  COLOR 7
  59. 530  RETURN
  60. 600  REM subroutine to print a single box
  61. 605  COLOR 3
  62. 610  FOR I = R1 + 1 TO R2 - 1
  63. 620   LOCATE I, C1 : PRINT CHR$(179);
  64. 630   LOCATE I, C2 : PRINT CHR$(179);
  65. 640  NEXT I
  66. 650  FOR J = C1 + 1 TO C2 - 1
  67. 660   LOCATE R1, J : PRINT CHR$(196);
  68. 670   LOCATE R2, J : PRINT CHR$(196);
  69. 680  NEXT J
  70. 690   LOCATE R1, C1 : PRINT CHR$(218);
  71. 700   LOCATE R1, C2 : PRINT CHR$(191);
  72. 710   LOCATE R2, C1 : PRINT CHR$(192);
  73. 720   LOCATE R2, C2 : PRINT CHR$(217);
  74. 725  COLOR 7
  75. 730  RETURN
  76. 740  REM ask user to press a key to continue
  77. 750  LOCATE 25,1
  78. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  79. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  80. 780  CLS
  81. 840  CLS
  82. 850  GOTO 2450
  83. 1000  REM Display (showgene) Program.
  84. 1010  REM By:  Melvin O. Duke.  Last Updated:  24 December 1984.
  85. 1020  REM Draw the form on the display
  86. 1030  R1= 1 : C1= 1 : R2=21 : C2=79: GOSUB 400 'Double box
  87. 1040  R1= 3 : C1= 1 : R2= 3 : C2=79: GOSUB 2170 'Horizontal Double
  88. 1050  LOCATE 2,3 : PRINT "Pedigree Chart for:"
  89. 1060  LOCATE 4,68 : COLOR 1 : PRINT "Birthdate:"
  90. 1070  LOCATE 12, 3 : I = 1 : GOSUB 1470
  91. 1080  LOCATE  8,11 : PRINT CHR$(218)+CHR$(196);
  92. 1090  LOCATE  9,11 : PRINT CHR$(179);
  93. 1100  LOCATE 10,11 : PRINT CHR$(179);
  94. 1110  LOCATE 11,11 : PRINT CHR$(179);
  95. 1120  LOCATE  8,13 : I = 2 : GOSUB 1510
  96. 1130  LOCATE 16,11 : PRINT CHR$(192)+CHR$(196);
  97. 1140  LOCATE 13,11 : PRINT CHR$(179);
  98. 1150  LOCATE 14,11 : PRINT CHR$(179);
  99. 1160  LOCATE 15,11 : PRINT CHR$(179);
  100. 1170  LOCATE 16,13 : I = 3 : GOSUB 1510
  101. 1180  LOCATE  6,21 : PRINT CHR$(218)+CHR$(196);
  102. 1190  LOCATE  7,21 : PRINT CHR$(179);
  103. 1200  LOCATE  6,23 : I = 4 : GOSUB 1540
  104. 1210  LOCATE 10,21 : PRINT CHR$(192)+CHR$(196);
  105. 1220  LOCATE  9,21 : PRINT CHR$(179);
  106. 1230  LOCATE 10,23 : I = 5 : GOSUB 1540
  107. 1240  LOCATE 14,21 : PRINT CHR$(218)+CHR$(196);
  108. 1250  LOCATE 15,21 : PRINT CHR$(179);
  109. 1260  LOCATE 14,23 : I = 6 : GOSUB 1540
  110. 1270  LOCATE 18,21 : PRINT CHR$(192)+CHR$(196);
  111. 1280  LOCATE 17,21 : PRINT CHR$(179);
  112. 1290  LOCATE 18,23 : I = 7 : GOSUB 1540
  113. 1300  LOCATE  5,31 : PRINT CHR$(218)+CHR$(196);
  114. 1310  LOCATE  5,33 : I = 8 : GOSUB 1570
  115. 1320  LOCATE  7,31 : PRINT CHR$(192)+CHR$(196);
  116. 1330  LOCATE  7,33 : I = 9 : GOSUB 1570
  117. 1340  LOCATE  9,31 : PRINT CHR$(218)+CHR$(196);
  118. 1350  LOCATE  9,33 : I = 10 : GOSUB 1570
  119. 1360  LOCATE 11,31 : PRINT CHR$(192)+CHR$(196);
  120. 1370  LOCATE 11,33 : I = 11 : GOSUB 1570
  121. 1380  LOCATE 13,31 : PRINT CHR$(218)+CHR$(196);
  122. 1390  LOCATE 13,33 : I = 12 : GOSUB 1570
  123. 1400  LOCATE 15,31 : PRINT CHR$(192)+CHR$(196);
  124. 1410  LOCATE 15,33 : I = 13 : GOSUB 1570
  125. 1420  LOCATE 17,31 : PRINT CHR$(218)+CHR$(196);
  126. 1430  LOCATE 17,33 : I = 14 : GOSUB 1570
  127. 1440  LOCATE 19,31 : PRINT CHR$(192)+CHR$(196);
  128. 1450  LOCATE 19,33 : I = 15 : GOSUB 1570
  129. 1455  COLOR 7,0
  130. 1460  RETURN
  131. 1470  REM Routine to print the lines
  132. 1480  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  133. 1490  COLOR 3,0 : PRINT STRING$(62,95);
  134. 1500  RETURN
  135. 1510  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  136. 1520  COLOR 3,0 : PRINT STRING$(52,95);
  137. 1530  RETURN
  138. 1540  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  139. 1550  COLOR 3,0 : PRINT STRING$(42,95);
  140. 1560  RETURN
  141. 1570  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  142. 1580  COLOR 3,0 : PRINT STRING$(32,95);
  143. 1590  RETURN
  144. 1600  REM Draw the Personal Information Chart
  145. 1610  CLS
  146. 1620  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  147. 1630  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal double
  148. 1640  LOCATE 2,3 : PRINT "Personal Information for:"
  149. 1650  R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2310  'Vertical Double
  150. 1660  LOCATE 4,3 : COLOR 1 : PRINT "Person:";
  151. 1665  LOCATE 5,3 : COLOR 6 : PRINT "Record-no.:";
  152. 1670  LOCATE 6,3 : PRINT "Surname:";
  153. 1680  LOCATE 7,3 : PRINT "Given-names:";
  154. 1690  LOCATE 8,3 : PRINT "Sex:";
  155. 1700  R1 = 9 : C1 = 1 : R2 =11 : C2 = 40 : GOSUB 2170  'Horizontal Double
  156. 1710  LOCATE 10,3 : COLOR 1 : PRINT "Person's Father:";
  157. 1715  LOCATE 11,3 : COLOR 6 : PRINT "Record-no.:";
  158. 1720  LOCATE 12,3 : PRINT "Surname:";
  159. 1730  LOCATE 13,3 : PRINT "Given-names:";
  160. 1740  LOCATE 14,3 : PRINT "Birth-date:";
  161. 1750  R1 = 15 : C1 = 1 : R2 = 15 : C2 = 40 : GOSUB 2240  'Horizontal Single
  162. 1760  LOCATE 16,3 : COLOR 1 : PRINT "Person's Mother:";
  163. 1765  LOCATE 17,3 : COLOR 6 : PRINT "Record-no.:";
  164. 1770  LOCATE 18,3 : PRINT "Surname:";
  165. 1780  LOCATE 19,3 : PRINT "Given-names:";
  166. 1790  LOCATE 20,3 : PRINT "Birth-date:";
  167. 1800  LOCATE 4,42 : COLOR 1 : PRINT "Person's Vital Statistics:";
  168. 1810  LOCATE 6,42 : COLOR 6 : PRINT "Birth-date:";
  169. 1820  LOCATE 7,42 : PRINT "Birth-city:";
  170. 1830  LOCATE 8,42 : PRINT "Birth-county:";
  171. 1840  LOCATE 9,42 : PRINT "Birth-state:";
  172. 1850  LOCATE 11,42 : PRINT "Death-date:";
  173. 1860  LOCATE 12,42 : PRINT "Death-city:";
  174. 1870  LOCATE 13,42 : PRINT "Death-county:";
  175. 1880  LOCATE 14,42 : PRINT "Death-state:";
  176. 1890  LOCATE 16,42 : PRINT "Burial-date:";
  177. 1900  LOCATE 17,42 : PRINT "Burial-city:";
  178. 1910  LOCATE 18,42 : PRINT "Burial-county:";
  179. 1920  LOCATE 19,42 : PRINT "Burial-state:"; : COLOR 7,0
  180. 1930  RETURN
  181. 1940  REM draw a Family Group Sheet
  182. 1950  CLS
  183. 1960  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  184. 1970  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Double Horizontal
  185. 1980  LOCATE 2,3 : PRINT "Family Group Record";
  186. 1985  LOCATE 2,64 : PRINT "Marriage:";
  187. 1990  LOCATE 4,3 : COLOR 6 : PRINT "Father:";
  188. 2000  LOCATE 4,56 : PRINT "Birthdate:";
  189. 2010  LOCATE 5,3 : PRINT "Mother:";
  190. 2020  LOCATE 5,56 : PRINT "Birthdate:";
  191. 2030  R1 = 6 : C1 = 1 : R2 = 6 : C2 = 79 : GOSUB 2240  'Single Horizontal
  192. 2040  LOCATE 7,3 : COLOR 6 : PRINT "Marriage Date:";
  193. 2050  LOCATE 7,35 : PRINT "Location:";
  194. 2060  R1 = 8 : C1 = 1 : R2 = 8 : C2 = 79 : GOSUB 2170  'Double Horizontal
  195. 2070  R1 = 8 : C1 = 4 : R2 = 21 : C2 = 4 : GOSUB 2380  'Single Vertical
  196. 2080  R1 = 8 : C1 = 6 : R2 = 21 : C2 = 6 : GOSUB 2380  'Single Vertical
  197. 2090  R1 = 8 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2380  'Single Vertical
  198. 2100  LOCATE 9,2 : COLOR 1 : PRINT "NO";
  199. 2110  LOCATE 9,5 : PRINT "S";
  200. 2120  LOCATE 9,7 : PRINT "Children:";
  201. 2130  LOCATE 9,41 : PRINT "Birthdate:";
  202. 2140  R1 = 8 : C1 = 52 : R2 = 21 : C2 = 52 : GOSUB 2380  'Single Vertical
  203. 2150  LOCATE 9,53 : COLOR 1 : PRINT "Birth Location:"; : COLOR 7
  204. 2160  RETURN
  205. 2170  REM Subroutine to draw a double horizontal line.  Attach to double.
  206. 2175  COLOR 5
  207. 2180  FOR J = C1 + 1 TO C2 - 1
  208. 2190   LOCATE R1,J : PRINT CHR$(205);
  209. 2200  NEXT J
  210. 2210  LOCATE R1,C1 : PRINT CHR$(204);
  211. 2220  LOCATE R1,C2 : PRINT CHR$(185);
  212. 2225  COLOR 7
  213. 2230  RETURN
  214. 2240  REM Subroutine to draw a single horizontal line.  Attach to double.
  215. 2245  COLOR 5
  216. 2250  FOR J = C1 + 1 TO C2 - 1
  217. 2260   LOCATE R1,J : PRINT CHR$(196);
  218. 2270  NEXT J
  219. 2280  LOCATE R1,C1 : PRINT CHR$(199);
  220. 2290  LOCATE R1,C2 : PRINT CHR$(182);
  221. 2295  COLOR 7
  222. 2300  RETURN
  223. 2310  REM Subroutine to draw a double vertical line.  Attach to double.
  224. 2315  COLOR 5
  225. 2320  FOR I = R1 + 1 TO R2 - 1
  226. 2330   LOCATE I,C1 : PRINT CHR$(186);
  227. 2340  NEXT I
  228. 2350  LOCATE R1,C1 : PRINT CHR$(203);
  229. 2360  LOCATE R2,C1 : PRINT CHR$(202);
  230. 2365  COLOR 7
  231. 2370  RETURN
  232. 2380  REM Subroutine to draw a single vertical line.  Attach to double.
  233. 2385  COLOR 5
  234. 2390  FOR I = R1 + 1 TO R2 - 1
  235. 2400   LOCATE I,C1 : PRINT CHR$(179);
  236. 2410  NEXT I
  237. 2420  LOCATE R1,C1 : PRINT CHR$(209);
  238. 2430  LOCATE R2,C1 : PRINT CHR$(207);
  239. 2435  COLOR 7
  240. 2440  RETURN
  241. 2450  REM Program begins here
  242. 2460  REM By:  Melvin O. Duke.
  243. 2470  REM Read the Parent/Child Index
  244. 2480  OPEN "a:pcindex" FOR INPUT AS #1
  245. 2490  LOCATE 4,1 : PRINT "Open the Parent/Child Index";
  246. 2500  INPUT #1, PC.COUNT
  247. 2510  FOR I = 1 TO PC.COUNT
  248. 2520  LOCATE 5,1 : PRINT "Reading Index Record #:";I;
  249. 2530   INPUT #1, PA.ID(I), CH.ID(I)
  250. 2540  NEXT I
  251. 2550  CLOSE #1
  252. 2560  REM Read the Marriage Index
  253. 2570  LOCATE 7,1 : PRINT "Open the Marriage Index";
  254. 2580  OPEN "a:mindex" FOR INPUT AS #2
  255. 2590  INPUT #2, M.COUNT
  256. 2600  FOR I = 1 TO M.COUNT
  257. 2610  LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
  258. 2620   INPUT #2,PERS.NO(I), M.NO(I)
  259. 2630  NEXT I
  260. 2640  CLOSE #2
  261. 2650  REM Open the Persons File
  262. 2660  LOCATE 10,1 : PRINT "Open the Persons File"
  263. 2670  OPEN "a:persfile" AS #1 LEN = 256
  264. 2680  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  265. 2690  REM open the Marriages File
  266. 2700  LOCATE 12,1 : PRINT "Open the Marriage File"
  267. 2710  OPEN "a:marrfile" AS #2 LEN = 128
  268. 2720  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  269. 2730  REM Open the Ordinance File
  270. 2740  LOCATE 14,1 : PRINT "Open the Ordinances File";
  271. 2750  OPEN "a:ordfile" AS #3 LEN = 256
  272. 2760  FIELD 3,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  273. 2770  REM Obtain a Person Record from the User
  274. 2780  LOCATE 20,1 : PRINT SPACE$(79);
  275. 2790  LOCATE 20,1 : INPUT "Enter the Record-number of a Person (0 to quit)";PERS(1)
  276. 2800  IF PERS(1) < 0 OR PERS(1) > 500 THEN CLS: GOTO 2770
  277. 2805  IF PERS(1) = 0 THEN 7390
  278. 2810  REM Obtain the information about a person
  279. 2820  GET #1, PERS(1)
  280. 2830  GOSUB 3300  'Extract Personal Information
  281. 2840  GOSUB 1600  'Draw the Form
  282. 2850  LOCATE 2,30 : COLOR 7 : PRINT T3$ + " " + T2$;
  283. 2854  LOCATE 2,66 : PRINT "Person:";T1
  284. 2855  LOCATE 5,16 : COLOR 2 : PRINT T1
  285. 2860  LOCATE 6,16 : PRINT T2$;
  286. 2870  LOCATE 7,16 : PRINT T3$;
  287. 2880  LOCATE 8,16 : PRINT T4$;
  288. 2890  LOCATE 6,57 : PRINT T8$;
  289. 2900  LOCATE 7,57 : PRINT T9$;
  290. 2910  LOCATE 8,57 : PRINT T10$;
  291. 2920  LOCATE 9,57 : PRINT T11$;
  292. 2930  LOCATE 11,57 : PRINT T12$;
  293. 2940  LOCATE 12,57 : PRINT T13$;
  294. 2950  LOCATE 13,57 : PRINT T14$;
  295. 2960  LOCATE 14,57 : PRINT T15$;
  296. 2970  LOCATE 16,57 : PRINT T16$;
  297. 2980  LOCATE 17,57 : PRINT T17$;
  298. 2990  LOCATE 18,57 : PRINT T18$;
  299. 3000  LOCATE 19,57 : PRINT T19$;
  300. 3010  PERS(2) = T6
  301. 3020  PERS(3) = T7
  302. 3025  COLOR 7
  303. 3030  REM Check if Father is known
  304. 3040  IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3065
  305. 3050  GET #1, PERS(2)
  306. 3060  GOSUB 3300  'Extract
  307. 3065  LOCATE 11,16 : COLOR 2 : PRINT T1;
  308. 3070  LOCATE 12,16 : PRINT T2$;
  309. 3080  LOCATE 13,16 : PRINT T3$;
  310. 3090  LOCATE 14,16 : PRINT T8$;
  311. 3095  COLOR 7
  312. 3100  REM Check if Mother is known
  313. 3110  IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 3135
  314. 3120  GET #1, PERS(3)
  315. 3130  GOSUB 3300  'Extract
  316. 3135  LOCATE 17,16 : COLOR 2 : PRINT T1;
  317. 3140  LOCATE 18,16 : PRINT T2$;
  318. 3150  LOCATE 19,16 : PRINT T3$;
  319. 3160  LOCATE 20,16 : PRINT T8$;
  320. 3170  COLOR 7,0 : LOCATE 23,1 : PRINT SPACE$(79);
  321. 3180  LOCATE 24,1 : PRINT SPACE$(79);
  322. 3190  LOCATE 24,1 : PRINT "(Possible Actions:  ps, pc, fg, ";
  323. 3191  PRINT "o, ";
  324. 3192  PRINT "p1...pn, m1...mn, q)";
  325. 3200  LOCATE 23,1 : INPUT "Next Action"; REPLY$
  326. 3210  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 3170
  327. 3220  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 3170
  328. 3230  IF REPLY$ = "pc" THEN 3800  'Pedigree Chart
  329. 3240  IF REPLY$ = "fg" THEN 5070  'Family Group
  330. 3250  IF REPLY$ = "o" THEN 6220  'Ordinances
  331. 3260  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : CLS : GOTO 2800
  332. 3270  IF LEFT$(REPLY$,1) = "m" THEN 7260
  333. 3280  IF LEFT$(REPLY$,1) = "q" THEN 7390
  334. 3290  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 3170
  335. 3300  REM Routine to Extract Personal Information
  336. 3310  T1 = CVS(F1$)
  337. 3320  T2$ = F2$
  338. 3330  FOR J = 1 TO LEN(F2$) -1
  339. 3340   IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  340. 3350  NEXT J
  341. 3360  T3$ = F3$
  342. 3370  FOR J = 1 TO LEN(F3$) -1
  343. 3380   IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  344. 3390  NEXT J
  345. 3400  T4$ = F4$
  346. 3410  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  347. 3420  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  348. 3430  T5 = CVS(F5$)
  349. 3440  T6 = CVS(F6$)
  350. 3450  T7 = CVS(F7$)
  351. 3460  T8$ = F8$
  352. 3470  T9$ = F9$
  353. 3480  T10$ = F10$
  354. 3490  T11$ = F11$
  355. 3500  T12$ = F12$
  356. 3510  T13$ = F13$
  357. 3520  T14$ = F14$
  358. 3530  T15$ = F15$
  359. 3540  T16$ = F16$
  360. 3550  T17$ = F17$
  361. 3560  T18$ = F18$
  362. 3570  T19$ = F19$
  363. 3580  RETURN
  364. 3590  REM Blank out a Record
  365. 3600  T1 = 0
  366. 3610  T2$ = ""
  367. 3620  T3$ = ""
  368. 3630  T4$ = ""
  369. 3640  T5 = 0
  370. 3650  T6 = 0
  371. 3660  T7 = 0
  372. 3670  T8$ = ""
  373. 3680  T9$ = ""
  374. 3690  T10$ = ""
  375. 3700  T11$ = ""
  376. 3710  T12$ = ""
  377. 3720  T13$ = ""
  378. 3730  T14$ = ""
  379. 3740  T15$ = ""
  380. 3750  T16$ = ""
  381. 3760  T17$ = ""
  382. 3770  T18$ = ""
  383. 3780  T19$ = ""
  384. 3790  RETURN
  385. 3800  REM Routine to Produce a Pedigree Chart
  386. 3810  CLS
  387. 3820  GOSUB 1000 'Draw the Chart
  388. 3830  GET #1, PERS(1)
  389. 3840  GOSUB 3300  'Extract the Person
  390. 3850  LOCATE 2,23 : COLOR 7 : PRINT T3$ + " " + T2$;
  391. 3855  LOCATE 2,66 : PRINT "Person:"; PERS(1);
  392. 3859  THIS.PERS = PERS(1) : GOSUB 7460
  393. 3860  LOCATE 12,6 : COLOR 2 : PRINT VALUE$;
  394. 3870  LOCATE 12,68 : PRINT T8$;
  395. 3880  PERS(2) = T6
  396. 3890  PERS(3) = T7
  397. 3900  REM Get 11
  398. 3910  IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3960
  399. 3920  GET #1, PERS(2)
  400. 3930  GOSUB 3300  'Extract
  401. 3939  THIS.PERS = PERS(2) : GOSUB 7460
  402. 3940  LOCATE 8,16 : PRINT VALUE$;
  403. 3950  LOCATE 8,68 : PRINT T8$;
  404. 3960  PERS(4) = T6
  405. 3970  PERS(5) = T7
  406. 3980  REM Get 10
  407. 3990  IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 4040
  408. 4000  GET #1, PERS(3)
  409. 4010  GOSUB 3300  'Extract
  410. 4019  THIS.PERS = PERS(3): GOSUB 7460
  411. 4020  LOCATE 16,16 : PRINT VALUE$;
  412. 4030  LOCATE 16,68 : PRINT T8$;
  413. 4040  PERS(6) = T6
  414. 4050  PERS(7) = T7
  415. 4060  REM Get 111
  416. 4070  IF PERS(4) = 0 THEN GOSUB 3590 : GOTO 4120
  417. 4080  GET #1, PERS(4)
  418. 4090  GOSUB 3300  'Extract
  419. 4099  THIS.PERS = PERS(4): GOSUB 7460
  420. 4100  LOCATE 6,26 : PRINT VALUE$;
  421. 4110  LOCATE 6,68 : PRINT T8$;
  422. 4120  PERS(8) = T6
  423. 4130  PERS(9) = T7
  424. 4140  REM Get 110
  425. 4150  IF PERS(5) = 0 THEN GOSUB 3590 : GOTO 4200
  426. 4160  GET #1, PERS(5)
  427. 4170  GOSUB 3300  'Extract
  428. 4179  THIS.PERS = PERS(5): GOSUB 7460
  429. 4180  LOCATE 10,26 : PRINT VALUE$;
  430. 4190  LOCATE 10,68 : PRINT T8$;
  431. 4200  PERS(10) = T6
  432. 4210  PERS(11) = T7
  433. 4220  REM Get 101
  434. 4230  IF PERS(6) = 0 THEN GOSUB 3590 : GOTO 4280
  435. 4240  GET #1, PERS(6)
  436. 4250  GOSUB 3300  'Extract
  437. 4259  THIS.PERS = PERS(6): GOSUB 7460
  438. 4260  LOCATE 14,26 : PRINT VALUE$;
  439. 4270  LOCATE 14,68 : PRINT T8$;
  440. 4280  PERS(12) = T6
  441. 4290  PERS(13) = T7
  442. 4300  REM Get 100
  443. 4310  IF PERS(7) = 0 THEN GOSUB 3590 : GOTO 4360
  444. 4320  GET #1, PERS(7)
  445. 4330  GOSUB 3300  'Extract
  446. 4339  THIS.PERS = PERS(7): GOSUB 7460
  447. 4340  LOCATE 18,26 : PRINT VALUE$;
  448. 4350  LOCATE 18,68 : PRINT T8$;
  449. 4360  PERS(14) = T6
  450. 4370  PERS(15) = T7
  451. 4380  REM Get 1111
  452. 4390  IF PERS(8) = 0 THEN GOSUB 3590 : GOTO 4440
  453. 4400  GET #1, PERS(8)
  454. 4410  GOSUB 3300  'Extract
  455. 4419  THIS.PERS = PERS(8): GOSUB 7460
  456. 4420  LOCATE  5,36 : PRINT VALUE$;
  457. 4430  LOCATE  5,68 : PRINT T8$;
  458. 4440  REM
  459. 4450  REM Get 1110
  460. 4460  IF PERS(9) = 0 THEN GOSUB 3590 : GOTO 4510
  461. 4470  GET #1, PERS(9)
  462. 4480  GOSUB 3300  'Extract
  463. 4489  THIS.PERS = PERS(9): GOSUB 7460
  464. 4490  LOCATE  7,36 : PRINT VALUE$;
  465. 4500  LOCATE  7,68 : PRINT T8$;
  466. 4510  REM
  467. 4520  REM Get 1101
  468. 4530  IF PERS(10) = 0 THEN GOSUB 3590 : GOTO 4580
  469. 4540  GET #1, PERS(10)
  470. 4550  GOSUB 3300  'Extract
  471. 4559  THIS.PERS = PERS(10): GOSUB 7460
  472. 4560  LOCATE  9,36 : PRINT VALUE$;
  473. 4570  LOCATE  9,68 : PRINT T8$;
  474. 4580  REM
  475. 4590  REM Get 1100
  476. 4600  IF PERS(11) = 0 THEN GOSUB 3590 : GOTO 4650
  477. 4610  GET #1, PERS(11)
  478. 4620  GOSUB 3300  'Extract
  479. 4629  THIS.PERS = PERS(11): GOSUB 7460
  480. 4630  LOCATE 11,36 : PRINT VALUE$;
  481. 4640  LOCATE 11,68 : PRINT T8$;
  482. 4650  REM
  483. 4660  REM Get 1011
  484. 4670  IF PERS(12) = 0 THEN GOSUB 3590 : GOTO 4720
  485. 4680  GET #1, PERS(12)
  486. 4690  GOSUB 3300  'Extract
  487. 4699  THIS.PERS = PERS(12): GOSUB 7460
  488. 4700  LOCATE 13,36 : PRINT VALUE$;
  489. 4710  LOCATE 13,68 : PRINT T8$;
  490. 4720  REM
  491. 4730  REM Get 1010
  492. 4740  IF PERS(13) = 0 THEN GOSUB 3590 : GOTO 4790
  493. 4750  GET #1, PERS(13)
  494. 4760  GOSUB 3300  'Extract
  495. 4769  THIS.PERS = PERS(13): GOSUB 7460
  496. 4770  LOCATE 15,36 : PRINT VALUE$;
  497. 4780  LOCATE 15,68 : PRINT T8$;
  498. 4790  REM
  499. 4800  REM Get 1001
  500. 4810  IF PERS(14) = 0 THEN GOSUB 3590 : GOTO 4860
  501. 4820  GET #1, PERS(14)
  502. 4830  GOSUB 3300  'Extract
  503. 4839  THIS.PERS = PERS(14): GOSUB 7460
  504. 4840  LOCATE 17,36 : PRINT VALUE$;
  505. 4850  LOCATE 17,68 : PRINT T8$;
  506. 4860  REM
  507. 4870  REM Get 1000
  508. 4880  IF PERS(15) = 0 THEN GOSUB 3590 : GOTO 4930
  509. 4890  GET #1, PERS(15)
  510. 4900  GOSUB 3300  'Extract
  511. 4909  THIS.PERS = PERS(15): GOSUB 7460
  512. 4910  LOCATE 19,36 : PRINT VALUE$;
  513. 4920  LOCATE 19,68 : PRINT T8$; : COLOR 7
  514. 4930  REM
  515. 4940  LOCATE 23,1 : PRINT SPACE$(79);
  516. 4950  LOCATE 24,1 : PRINT SPACE$(79);
  517. 4960  LOCATE 24,1 : PRINT "(Possible Actions:  ps, pc, fg, l1...ln, p1...pn, m1...mn, q)";
  518. 4970  LOCATE 23,1 : INPUT "Next Action"; REPLY$
  519. 4980  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 4940
  520. 4990  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 4940
  521. 5000  IF REPLY$ = "pc" THEN 3800
  522. 5010  IF REPLY$ = "fg" THEN 5070
  523. 5020  IF LEFT$(REPLY$,1) = "l" THEN PERS(1) = PERS(VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))) : GOTO 2810
  524. 5030  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  525. 5040  IF LEFT$(REPLY$,1) = "m" THEN 7260
  526. 5050  IF LEFT$(REPLY$,1) = "q" THEN 7390
  527. 5060  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 4940
  528. 5070  REM Routine to Produce a Family Group Record
  529. 5080  CLS
  530. 5090  GOSUB 1940  'Draw the form
  531. 5100  REM search the marriage index for the Person's Marriage
  532. 5110  FOUND = 0
  533. 5120  FOR L = 1 TO M.COUNT
  534. 5130   IF PERS(1) > PERS.NO(L) THEN 5190
  535. 5140   IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 5190
  536. 5150   REM found a Marriage
  537. 5160   FOUND = 1
  538. 5170   GET #2, M.NO(L)
  539. 5180   L = M.COUNT
  540. 5190  NEXT L
  541. 5200  IF FOUND = 1 THEN 5260
  542. 5210  REM No marriage found
  543. 5220  LOCATE 22,1 : COLOR 7,0 : PRINT "No Marriage Found";
  544. 5230  LOCATE 23,1 : PRINT "Press any key to continue";
  545. 5240  A$ = INKEY$ : IF A$ = "" THEN 5240
  546. 5250  CLS : GOTO 2810
  547. 5260  REM extract Information from the Marriage Record
  548. 5270  TT1 = CVS(M1$)
  549. 5275  IF TT1 < 1 THEN 5210
  550. 5280  TT2 = CVS(M2$)
  551. 5290  TT3 = CVS(M3$)
  552. 5300  TT4 = CVS(M4$)
  553. 5310  TT5$ = M5$
  554. 5320  TT6$ = M6$
  555. 5330  TT7$ = M7$
  556. 5340  TT8$ = M8$
  557. 5350  TT9$ = M9$
  558. 5360  REM print the Marriage Information
  559. 5365  LOCATE 2,73 : COLOR 7 : PRINT TT1
  560. 5370  LOCATE 7,18 : COLOR 2 : PRINT TT5$
  561. 5380  LOCATE 7,45 : PRINT TT6$
  562. 5390  REM get the Husband's Record
  563. 5400  GET #1, TT2
  564. 5410  GOSUB 3300  'Extract
  565. 5419  THIS.PERS = TT2 : GOSUB 7460
  566. 5420  LOCATE 4,11 : COLOR 2 : PRINT VALUE$;
  567. 5430  LOCATE 4,67 : PRINT T8$;
  568. 5440  REM get the Wife's Record
  569. 5450  GET #1, TT3
  570. 5460  GOSUB 3300  'Extract
  571. 5469  THIS.PERS = TT3 : GOSUB 7460
  572. 5470  LOCATE 5,11 : COLOR 2 : PRINT VALUE$;
  573. 5480  LOCATE 5,67 : PRINT T8$;
  574. 5490  REM now find the children
  575. 5500  CHILD.COUNT = 0
  576. 5510  FOR IC = 1 TO 55
  577. 5520   CH(IC) = 0
  578. 5530  NEXT IC
  579. 5540  REM search the parent/child index
  580. 5550  FOR LL = 1 TO PC.COUNT
  581. 5560   IF TT2 > PA.ID(LL) THEN 5890
  582. 5570   IF TT2 < PA.ID(LL) THEN LL = PC.COUNT : GOTO 5890
  583. 5580   REM found a child
  584. 5590   GET #1, CH.ID(LL)
  585. 5600   GOSUB 3300  'Extract
  586. 5610   REM verify that Mother is the same
  587. 5620   IF TT3 <> T7 THEN 5890
  588. 5630   REM Found a valid child
  589. 5640   CHILD.COUNT = CHILD.COUNT + 1
  590. 5650   SHOW.COUNT = CHILD.COUNT
  591. 5660   IF CHILD.COUNT = 1 THEN 5820
  592. 5670   IF CHILD.COUNT > 11 THEN SHOW.COUNT = CHILD.COUNT - 11
  593. 5680   IF CHILD.COUNT > 22 THEN SHOW.COUNT = CHILD.COUNT - 22
  594. 5690   IF CHILD.COUNT > 33 THEN SHOW.COUNT = CHILD.COUNT - 33
  595. 5700   IF CHILD.COUNT > 44 THEN SHOW.COUNT = CHILD.COUNT - 44
  596. 5710   IF (CHILD.COUNT-1) MOD 11 = 0 THEN 5720 ELSE 5820
  597. 5720   LOCATE 23,1 : PRINT SPACE$(79);
  598. 5730   LOCATE 23,1 : COLOR 7 : PRINT "Press any key to continue"
  599. 5740   A$ = INKEY$ : IF A$ = "" THEN 5740
  600. 5750   REM blank the previous children
  601. 5760   FOR ROW = 9 TO 20
  602. 5770    LOCATE ROW,2 : PRINT SPACE$(77);
  603. 5780   NEXT ROW
  604. 5790   REM restore the rest of the display
  605. 5800   GOSUB 2070
  606. 5810   LOCATE 23,1 : PRINT SPACE$(79)
  607. 5820   CH(CHILD.COUNT) = CH.ID(LL)
  608. 5830   LOCATE 9+SHOW.COUNT,2 : COLOR 0,7
  609. 5840   PRINT RIGHT$(STR$(CHILD.COUNT),2); : COLOR 2,0
  610. 5850   LOCATE 9+SHOW.COUNT,5 : PRINT LEFT$(F4$,1);  'Sex
  611. 5860   LOCATE 9+SHOW.COUNT,7 : PRINT T2$+", "+T3$;
  612. 5870   LOCATE 9+SHOW.COUNT,41 : PRINT T8$;
  613. 5880   LOCATE 9+SHOW.COUNT,53 : PRINT T9$;
  614. 5885   COLOR 7,0
  615. 5890  NEXT LL
  616. 5900  LOCATE 23,1 : PRINT SPACE$(79);
  617. 5910  LOCATE 24,1 : PRINT SPACE$(79);
  618. 5920  LOCATE 24,1 : PRINT "(Possible Actions: ps, f, m, p1...pn, c1...cn, m1...mn, q)";
  619. 5930  LOCATE 23,1 : INPUT "Next Action";REPLY$
  620. 5940  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 5900
  621. 5950  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 5900
  622. 5960  IF REPLY$ = "pc" THEN LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  623. 5970  IF REPLY$ = "f" THEN PERS(1) = TT2 : GOTO 2810
  624. 5980  IF REPLY$ = "m" THEN PERS(1) = TT3 : GOTO 2810
  625. 5990  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  626. 6000  IF LEFT$(REPLY$,1) = "c" THEN 6010 ELSE 6050
  627. 6010  CHLD = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  628. 6020  IF CHLD < 1 OR CHLD > CHILD.COUNT THEN 6070
  629. 6030  PERS(1) = CH(CHLD)
  630. 6040  GOTO 2810  'for personal
  631. 6050  IF LEFT$(REPLY$,1) = "m" THEN 7260 'marriage
  632. 6060  IF LEFT$(REPLY$,1) = "q" THEN 7390
  633. 6070  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  634. 6080  REM Routine to Print the Screen
  635. 6090  REM Accessed by users 'ps' reply
  636. 6100  FOR ROW = 1 TO 20
  637. 6110   THIS$ = SPACE$(79)
  638. 6120   FOR COL = 1 TO 79
  639. 6130    X = SCREEN(ROW,COL)
  640. 6140    IF X > 125 THEN X = 32
  641. 6150    IF X < 32 THEN X = 32
  642. 6160    MID$(THIS$,COL,1) = CHR$(X)
  643. 6170   NEXT COL
  644. 6180   LPRINT THIS$
  645. 6190  NEXT ROW
  646. 6200  LPRINT CHR$(12);
  647. 6210  RETURN
  648. 6220  REM Routine to Display the Ordinances
  649. 6230  GET #1, PERS(1) : GOSUB 3300
  650. 6240  GET #3, PERS(1)
  651. 6250  SEX$ = LEFT$(T4$,1)
  652. 6260  REM Extract the Ordinance Information
  653. 6270  U1 = CVS(O1$)
  654. 6280  U2$ = O2$
  655. 6290  U3$ = O3$
  656. 6300  U4$ = O4$
  657. 6310  U5  = CVS(O5$)
  658. 6320  U6  = CVS(O6$)
  659. 6330  U7$ = O7$
  660. 6340  U8$ = O8$
  661. 6350  U9$ = O9$
  662. 6360  U10$ = O10$
  663. 6370  U11$ = O11$
  664. 6380  U12  = CVS(O12$)
  665. 6390  U13$ = O13$
  666. 6400  U14$ = O14$
  667. 6410  U15$ = O15$
  668. 6420  U16$ = O16$
  669. 6430  U17$ = O17$
  670. 6440  U18$ = O18$
  671. 6450  U19$ = O19$
  672. 6460  U20$ = O20$
  673. 6470  U21$ = O21$
  674. 6480  U22$ = O22$
  675. 6490  U23$ = O23$
  676. 6500  U24$ = O24$
  677. 6510  CLS
  678. 6520  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double Box
  679. 6530  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal Double
  680. 6540  R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 2170  'Horizontal Double
  681. 6550  LOCATE 2,3 : PRINT "Ordinance Information for:";
  682. 6560  LOCATE 4,7 : COLOR 1 : PRINT "Personal Record"; : COLOR 6
  683. 6570  LOCATE 5,3 : PRINT "Christening:";
  684. 6580  LOCATE 6,3 : PRINT "Blessing:";
  685. 6590  LOCATE 7,3 : PRINT "Sealed to Parents:";
  686. 6600  LOCATE 8,5 : PRINT "Father's Id:";
  687. 6610  LOCATE 9,6 : PRINT "Name:";
  688. 6620  LOCATE 10,5 : PRINT "Mother's Id:";
  689. 6630  LOCATE 11,6 : PRINT "Name:";
  690. 6640  LOCATE 12,3 : PRINT "Baptism:";
  691. 6650  LOCATE 13,3 : PRINT "Confirmation:";
  692. 6660  LOCATE 14,3 : PRINT "Patriarchical Blessing:";
  693. 6670  LOCATE 15,3 : PRINT "Endowment:";
  694. 6674  REM Test for male.  Skip if male.
  695. 6675  IF SEX$ = "M" THEN 6710
  696. 6680  LOCATE 16,3 : PRINT "Sealed to Husband:";
  697. 6690  LOCATE 17,5 : PRINT "Husband's Id.:";
  698. 6700  LOCATE 18,6 : PRINT "Name:";
  699. 6710  REM Test for Male.  Skip if not
  700. 6720  IF SEX$ <> "M" THEN 6860
  701. 6730  R1 = 3 : R2 = 19 : C1 = 40 : C2 = 40 : GOSUB 2310  "Vertical Double
  702. 6740  LOCATE 4,46 : COLOR 1 : PRINT "Priesthood Record"; : COLOR 6
  703. 6750  LOCATE 5,42 : PRINT "Aaronic Priesthood:";
  704. 6760  LOCATE 6,44 : PRINT "Deacon:";
  705. 6770  LOCATE 7,44 : PRINT "Teacher:";
  706. 6780  LOCATE 8,44 : PRINT "Priest:";
  707. 6790  LOCATE 10,42 : PRINT "Melchizedek Priesthood:";
  708. 6800  LOCATE 11,44 : PRINT "Elder:";
  709. 6810  LOCATE 12,44 : PRINT "Seventy:";
  710. 6820  LOCATE 13,44 : PRINT "High Priest:";
  711. 6830  LOCATE 15,42 : PRINT "Bishop:";
  712. 6840  LOCATE 16,42 : PRINT "Patriarch:";
  713. 6850  LOCATE 17,42 : PRINT "Apostle:";
  714. 6860  LOCATE 20,3  : PRINT "Occupation:";
  715. 6870  REM Print the Information Currently Present
  716. 6880  LOCATE 2,30 : COLOR 7 : PRINT T3$ + " " + T2$;
  717. 6890  LOCATE 2,66 : PRINT "Person:";T1;
  718. 6900  LOCATE 5,28 : COLOR 2 : PRINT U2$;
  719. 6910  LOCATE 6,28 : PRINT U3$;
  720. 6920  LOCATE 7,28 : PRINT U4$;
  721. 6940  LOCATE 8,18 : PRINT U5;
  722. 6950  IF U5 = 0 THEN 6980
  723. 6960  GET #1, U5 : GOSUB 3300  'Extract Father Information
  724. 6970  LOCATE 9,12 : PRINT T3$ + " " + T2$;
  725. 6980  LOCATE 10,18 : PRINT U6;
  726. 6990  IF U6 = 0 THEN 7020
  727. 7000  GET #1, U6 : GOSUB 3300  'Extract Mother Information
  728. 7010  LOCATE 11,12 : PRINT T3$ + " " + T2$;
  729. 7020  LOCATE 12,28 : PRINT U7$;
  730. 7030  LOCATE 13,28 : PRINT U8$;
  731. 7040  LOCATE 14,28 : PRINT U9$;
  732. 7050  LOCATE 15,28 : PRINT U10$;
  733. 7054  REM Test for male.  Skip if male.
  734. 7055  IF SEX$ = "M" THEN 7110
  735. 7060  LOCATE 16,28 : PRINT U11$;
  736. 7070  LOCATE 17,19 : PRINT U12;
  737. 7080  IF U12 = 0 THEN 7110
  738. 7090  GET #1, U12 : GOSUB 3300  'Extract Spouse Information
  739. 7100  LOCATE 18,12 : PRINT T3$ + " " + T2$;
  740. 7110  REM Test for Male.  Bypass if not.
  741. 7120  IF SEX$ <> "M" THEN 7240
  742. 7130  LOCATE 5,67 : PRINT U13$;
  743. 7140  LOCATE 6,67 : PRINT U14$;
  744. 7150  LOCATE 7,67 : PRINT U15$;
  745. 7160  LOCATE 8,67 : PRINT U16$;
  746. 7170  LOCATE 10,67 : PRINT U17$;
  747. 7180  LOCATE 11,67 : PRINT U18$;
  748. 7190  LOCATE 12,67 : PRINT U19$;
  749. 7200  LOCATE 13,67 : PRINT U20$;
  750. 7210  LOCATE 14,67 : PRINT U21$;
  751. 7220  LOCATE 15,67 : PRINT U22$;
  752. 7230  LOCATE 16,67 : PRINT U23$;
  753. 7240  LOCATE 20,15 : PRINT U24$;
  754. 7250  GOTO 3170  'For User Action
  755. 7260  REM Marriage was requested by Number
  756. 7270  MARRIAGE = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  757. 7280  CLS
  758. 7290  IF MARRIAGE > 0 AND MARRIAGE <= 200 THEN 7360
  759. 7300  LOCATE 22,1 : PRINT SPACE$(79);
  760. 7310  LOCATE 22,1 : COLOR 7 : PRINT "Invalid Marriage Number";
  761. 7320  LOCATE 23,1 : PRINT SPACE$(79);
  762. 7330  LOCATE 23,1 : PRINT "Press any key to continue."
  763. 7340  A$ = INKEY$ : IF A$ = "" THEN 7340
  764. 7350  GOTO 2810
  765. 7360  GOSUB 1940  'Print the form
  766. 7370  GET #2, MARRIAGE
  767. 7380  GOTO 5260
  768. 7390  REM Wrapup
  769. 7400  CLOSE #1
  770. 7410  CLOSE #2
  771. 7420  CLOSE #3
  772. 7430  CLS : LOCATE 21,1 : COLOR 7,0
  773. 7440  PRINT "End of Program"
  774. 7450  RUN "a:menu"
  775. 7460  REM Routine to Convert a number to a string.  This.pers is input
  776. 7470  REM value$ is output, with record number and persons name.
  777. 7480  VALUE$ = STR$(THIS.PERS)
  778. 7490  WIDE = LEN(VALUE$)
  779. 7500  VALUE$ = RIGHT$(VALUE$,WIDE-1)
  780. 7510  VALUE$ = "("+VALUE$+") "+T2$+", "+T3$
  781. 7520  RETURN
  782.